unit DownloadThread;

interface

uses
  Tiles, Generics.Collections, System.Classes, System.SyncObjs, IdHTTP, Interfaces;

type

  TTileDownloader = class;
  TDownloadThread = class(TThread)
  private
    FOwner : TTileDownloader;
    FHTTP : TIdHTTP;
    FIsDownloading : Boolean;
    FExecuting : Boolean;
    FHasTileReference : Boolean;

    procedure DownloadTile(Tile : TTile);
    procedure OutOfBoundsTile(Tile : TTile);
    procedure ConvertDataToArray(Data : TStringStream; var DataArray : TTileData);
    function GetURLForTile(const Tile : TTile) : string;
  public
    constructor Create(Owner : TTileDownloader);
    destructor Destroy; override;

    function IsDownloadingOrProcessing : Boolean;

    procedure Execute; override;
    procedure StopDownloading;

    property Executing : Boolean read FExecuting;
    property HasTileReference : Boolean read FHasTileReference;
  end;

  TDeleteTileCallback = procedure(const Tile : TTile) of object;

  TTileDownloader = class
  private
    FTileList : TList<TTile>;
    FAddedEvent : TEvent;
    FListLock : TCriticalSection;
    FThreadList : TList<TDownloadThread>;
    FHostForm : IHostForm;

    function PopTile : TTile;
    procedure EnsureThreadsExist;
    procedure StopAndFreeThreads;
    function AnyThreadsRunning : Boolean;
    function AnyThreadHoldingTileRef : Boolean;
    procedure StopAllThreadsHoldingTileRef;
  public
    constructor Create(InvalidateForm : IHostForm);
    destructor Destroy; override;

    procedure ClearAll;
    procedure AddTile(const Tile : TTile);
    procedure RemoveQueuedDownloadsNotInZoomRange(const MinZoom, MaxZoom : Integer; PFDeleteTile: TDeleteTileCallback);
    function IsWorking : Boolean;

    property Event : TEvent read FAddedEvent;
    property HostForm : IHostForm read FHostForm;
  end;

implementation

uses
  SysUtils, IdException, MandelbrotTiles;

{ TTileDownloadingThread }

constructor TTileDownloader.Create(InvalidateForm : IHostForm);
begin
  inherited Create;
  FHostForm := InvalidateForm;
  FTileList := TList<TTile>.Create;
  FAddedEvent := TEvent.Create(nil, False, False, ''); // Auto-reset
  FListLock := TCriticalSection.Create;
  FThreadList := nil; // Lazily created

  Randomize; // For selecting tiles from the list
end;

destructor TTileDownloader.Destroy;
begin
  ClearAll;
  StopAndFreeThreads;

  FTileList.Free;
  FAddedEvent.Free;
  FListLock.Free;

  inherited;
end;

function TTileDownloader.PopTile: TTile;
var
  Index : Integer;
begin
  Result := nil;
  FListLock.Acquire;
  try
    if FTileList.Count > 0 then begin
      // It actually looks better to return a random tile, otherwise tiles load in the order they
      // were added (eg L-R, T-B). Random tiles are evenly distributed all over the screen
      Index := Random(FTileList.Count); // 0 <= n < range
      Result := FTileList[Index];
      FTileList.Delete(Index);
    end;
  finally
    FListLock.Release;
  end;
end;

procedure TTileDownloader.RemoveQueuedDownloadsNotInZoomRange(const MinZoom, MaxZoom: Integer; PFDeleteTile : TDeleteTileCallback);
var
  Tile : TTile;
  Loop : Integer;
begin
  FListLock.Acquire;
  try
    // Reverse order since deleting
    for Loop := FTileList.Count-1 downto 0 do begin
      Tile := FTileList[Loop];
      if (Tile.Zoom < MinZoom) or (Tile.Zoom > MaxZoom) then begin
        // Don't delete the tile, just remove from the download list. Tiles are owned by the
        // MandelbrotTiles object, so tell it to delete this tile too
        FTileList.Delete(Loop);
        PFDeleteTile(Tile);
      end;
    end;
  finally
    FListLock.Release;
  end;
end;

procedure TTileDownloader.EnsureThreadsExist;
var
  Loop : Integer;
begin
  if not Assigned(FThreadList) then begin
    FThreadList := TList<TDownloadThread>.Create;
    // Most downloading is waiting. Have lots of threads trying to download (makes it noticeably faster)
    for Loop := 1 to CPUCount do
      FThreadList.Add(TDownloadThread.Create(Self));
  end;
end;

procedure TTileDownloader.StopAndFreeThreads;
var
  Thread : TDownloadThread;
begin
  if Assigned(FThreadList) then begin
    for Thread in FThreadList do begin
      Thread.Terminate;
    end;
    // Using cross-platform event objects, can only wait for one event at a time - there is no easy
    // way to wait for one of multiple events
    // Setting this event will now cause one of the threads to wake and quite, but we don't know
    // which one. So, loop setting the event (waking and quitting a random thread) until no threads
    // are in running state (flagged in Execute.)

    while AnyThreadsRunning do FAddedEvent.SetEvent;

    // Now, all have / will finish Execute
    for Thread in FThreadList do begin
      Thread.WaitFor;
      Thread.Free;
    end;
    FreeAndNil(FThreadList);
  end;
end;

function TTileDownloader.AnyThreadsRunning: Boolean;
var
  Thread : TDownloadThread;
begin
  if Assigned(FThreadList) then
    for Thread in FThreadList do
      if Thread.Executing then Exit(true);

  Result := false;
end;

function TTileDownloader.AnyThreadHoldingTileRef: Boolean;
var
  Thread : TDownloadThread;
begin
  if Assigned(FThreadList) then
    for Thread in FThreadList do
      if Thread.HasTileReference then Exit(true);

  Result := false;
end;

procedure TTileDownloader.StopAllThreadsHoldingTileRef;
var
  Thread : TDownloadThread;
begin
  // Immediately after ClearAll returns, the tiles are deleted. If a thread has one and is (eg)
  // downloading, it will crash. Wait until all threads have no tiles - they will be waiting on
  // an event, but the tilelist is empty so at this point guaranteed no references to tiles,
  // and none can be gained: safe to continue and delete all tiles.

  if Assigned(FThreadList) then
    for Thread in FThreadList do
      Thread.StopDownloading;

  while AnyThreadHoldingTileRef do Sleep(1); // Should be a few ms at absolute most
end;

function TTileDownloader.IsWorking: Boolean;
var
  Thread : TDownloadThread;
begin
  // Is the thread doing something - are there tiles to download?
  FListLock.Acquire;
  try
    Result := FTileList.Count > 0;
  finally
    FListLock.Release;
  end;

  // The tile list might be empty, but the thread might still be processing the last tile
  if not Result then if Assigned(FThreadList) then
    for Thread in FThreadList do
      if Thread.IsDownloadingOrProcessing then Exit(True);
end;

procedure TTileDownloader.AddTile(const Tile: TTile);
begin
  FListLock.Acquire;
  try
    FTileList.Add(Tile);
  finally
    FListLock.Release;
  end;
  EnsureThreadsExist; // Tiles are added; make sure threads exist to process them
  FAddedEvent.SetEvent;
end;

procedure TTileDownloader.ClearAll;
begin
  FListLock.Acquire;
  try
    FTileList.Clear;
  finally
    FListLock.Release;
  end;

  // Immediately after this method returns, the tiles are deleted. If a thread has one and is (eg)
  // downloading, it will crash. Wait until all threads have no tiles - they will be waiting on
  // an event, but the tilelist is empty (above) so at this point guaranteed no references to tiles,
  // and none can be gained: safe to continue and delete all tiles.
  StopAllThreadsHoldingTileRef;
end;

{ TDownloadThread }

constructor TDownloadThread.Create(Owner : TTileDownloader);
begin
  inherited Create;
  FExecuting := false;
  FOwner := Owner;
  FHTTP := TIdHTTP.Create(nil);
  FHTTP.ReadTimeout := 10000; // 10 seconds. Otherwise sometimes sits there forever...
  FHTTP.ConnectTimeout := 10000;
  FIsDownloading := False;
end;

destructor TDownloadThread.Destroy;
begin
  assert(not FExecuting);
  FHTTP.Free;
  inherited;
end;

procedure TDownloadThread.Execute;
var
  Tile : TTile;
begin
  NameThreadForDebugging('Tile downloader');

  FExecuting := true;
  try
    while not Terminated do begin
      FHasTileReference := false;

      FOwner.Event.WaitFor(INFINITE);
      if Terminated then Exit;

      Tile := FOwner.PopTile;
      FHasTileReference := Assigned(Tile);
      while (not Terminated) and Assigned(Tile) do begin
        if Tile.IsOutOfBounds then // Scrolled outside the set, zoomed out too far, etc - server won't have tiles
          OutOfBoundsTile(Tile)
        else
          DownloadTile(Tile);

        // Loop again
        Tile := FOwner.PopTile;
        FHasTileReference := Assigned(Tile);
      end;
      if (not Assigned(Tile)) and (not Terminated) then begin
        // Out of tiles to process.  Let the owner know so it can purge unnecessary tiles from memory
        Queue(
          procedure begin
            FOwner.HostForm.AllTilesDownloaded;
          end
        );
      end;
    end;
  finally
    FExecuting := false;
  end;
end;

function TDownloadThread.GetURLForTile(const Tile: TTile): string;
const
  BaseURL = 'http://mandelbrot.dwscript.net/api.dws?_ZOOM_-_XCOORD_-_YCOORD_.js';
begin
  Result := BaseURL;
  Result := StringReplace(Result, '_ZOOM_', IntToStr(Tile.Zoom), []);
  Result := StringReplace(Result, '_XCOORD_', IntToStr(Tile.X), []);
  Result := StringReplace(Result, '_YCOORD_', IntToStr(Tile.Y), []);
end;

function TDownloadThread.IsDownloadingOrProcessing: Boolean;
begin
  Result := FIsDownloading;
end;

procedure TDownloadThread.StopDownloading;
begin
  // Threads need to stop what they're doing.  If downloading, the TIdHTTP can block for long
  // periods of time: disconnect it to force a return straight away.
  if IsDownloadingOrProcessing then FHTTP.Disconnect;
end;

procedure TDownloadThread.OutOfBoundsTile(Tile: TTile);
var
  DataArray : TTileData;
begin
  // The tile is out of bounds: scrolled too far, etc. Server won't have data, so instead
  // init the tile with a one-element, 0-valued array
  SetLength(DataArray, 1);
  try
    DataArray[0] := 0;
    Tile.InitFromThreadWithData(DataArray);
  finally
    SetLength(DataArray, 0);
  end;
end;

procedure TDownloadThread.DownloadTile(Tile: TTile);
var
  URL : string;
  Data : TStringStream;
  DataArray : TTileData;
begin
  FIsDownloading := true; // For the UI spinner;

  try
    URL := GetURLForTile(Tile);
    Data := TStringStream.Create;
    try
      try
        FHTTP.Get(URL, Data);
        ConvertDataToArray(Data, DataArray);
        Tile.InitFromThreadWithData(DataArray);
      except on E : EIdException do
        Tile.InitFromThreadError(E, URL);
      end;
    finally
      Data.Free;
    end;
  finally
    FIsDownloading := False;
  end;

  // Called by the downloading thread when a tile has been initialised
  Queue(
    procedure begin
      FOwner.HostForm.TileAvailable;
    end
  );
end;

procedure TDownloadThread.ConvertDataToArray(Data: TStringStream; var DataArray: TTileData);
var
  Strings : TStringList;
  Loop : Integer;
begin
  //  "The response is a JSON array of the iteration depths on the smoothed Mandelbrot Set with the
  //  following convention:
  //  if the array contains only one element, then the tile is a uniform one (all points in the tiles
  //  have the same iteration depth). You can use that to optimize rendering.
  //  otherwise the array will contain 65536 elements, as a top-down raster of iteration depths"
  //   - http://www.delphitools.info/2013/12/24/a-terapixel-image-for-the-delphiwebscript-christmas/2/

  // A JSON array is in the format [ a, b, c, ... ].  So, remove the braces, and parse breaking at
  // each comma, adding to the data array. Simple (non-optimal!) way to achieve this is via
  // TStringList. I'd like to use the inbuilt JSON support but appears to be no way to init, eg, a
  // JSON array object from a string...?

  if Data.Size > 0 then begin
    Strings := TStringList.Create;
    try
      Strings.CommaText := Copy(Data.DataString, 2, Length(Data.DataString) - 2);
      if Strings.Count = 1 then begin
        SetLength(DataArray, 1);
        TryStrToInt(Strings[0], DataArray[0]);
      end else if Strings.Count = TILE_WIDTH * TILE_HEIGHT then begin
        SetLength(DataArray, TILE_WIDTH * TILE_HEIGHT);
        for Loop := 0 to Strings.Count-1 do begin
          TryStrToInt(Strings[Loop], DataArray[Loop]);
        end;
      end;
    finally
      Strings.Free;
    end;
  end;
end;

end.
